#this file is http://asteriskman.googlecode.com/hg/grooveSharkProxy/id3v2reader.tcl
#this code implements parsing of ID3v2.3.0 tags based on info at http://www.id3.org/id3v2.3.0
#this code implements parsing of ID3v2.2.0 tags based on info at http://www.id3.org/id3v2-00
#this code implements parsing ID3v1 and ID3v1.1 tags based on the info at http://www.id3.org/ID3v1
#this code implements parsing ID3v2.4.0 tags based on info at http://www.id3.org/id3v2.4.0-structure

namespace eval id3v2reader {
  variable nextTokenNumber 0
  array unset tokens
  variable implementedMajor 3
  variable implementedMinor 0
  variable textFieldNames
  set v2TextFieldNamesList {TAL album TBP bpm TCM composer TCO contentType TCR copyright TDA date TDY delay TEN encodedBy TFT fileType TIM time TKE key TLA language TLE length TMT mediaType TOA originalArtist TOF originalFilename TOL originalLyricist TOR originalYear TOT originalTitle TP1 artist TP2 band TP3 conductor TP4 remixer TPA partOfASet TPB publisher TRC isrc TRD recordingDates TRK track TSI size TSS encodingSettings TT1 contentGroupDescription TT2 title TT3 subtitle TXT lyricist TXX userDefined TYE year}
  set v3TextFieldNamesList {TALB album TBPM bpm TCOM composer TCON contentType TCOP copyright TDAT date TDLY delay TENC encodedBy TEXT lyricist TFLT fileType TIME time TIT1 contentGroupDescription TIT2 title TIT3 subtitle TKEY key TLAN language TLEN length TMED mediaType TOAL originalTitle TOFN originalFilename TOLY originalLyricist TOPE originalArtist TORY originalYear TOWN owner TPE1 artist TPE2 band TPE3 conductor TPE4 remixer TPOS partOfASet TPUB publisher TRCK track TRDA recordingDates TRSN stationName TRSO stationOwner TSIZ size TSRC isrc TSSE encodingSettings TYER year}
  set textFieldNamesList [concat $v2TextFieldNamesList $v3TextFieldNamesList]
  array set textFieldNames $textFieldNamesList
  set v2ContentTypesList {{0 Blues} {1 {Classic Rock}} {2 Country} {3 Dance} {4 Disco} {5 Funk} {6 Grunge} {7 Hip-Hop} {8 Jazz} {9 Metal} {10 {New Age}} {11 Oldies} {12 Other} {13 Pop} {14 R&B} {15 Rap} {16 Reggae} {17 Rock} {18 Techno} {19 Industrial} {20 Alternative} {21 Ska} {22 {Death Metal}} {23 Pranks} {24 Soundtrack} {25 Euro-Techno} {26 Ambient} {27 Trip-Hop} {28 Vocal} {29 Jazz+Funk} {30 Fusion} {31 Trance} {32 Classical} {33 Instrumental} {34 Acid} {35 House} {36 Game} {37 {Sound Clip}} {38 Gospel} {39 Noise} {40 AlternRock} {41 Bass} {42 Soul} {43 Punk} {44 Space} {45 Meditative} {46 {Instrumental Pop}} {47 {Instrumental Rock}} {48 Ethnic} {49 Gothic} {50 Darkwave} {51 Techno-Industrial} {52 Electronic} {53 Pop-Folk} {54 Eurodance} {55 Dream} {56 {Southern Rock}} {57 Comedy} {58 Cult} {59 Gangsta} {60 {Top 40}} {61 {Christian Rap}} {62 Pop/Funk} {63 Jungle} {64 {Native American}} {65 Cabaret} {66 {New Wave}} {67 Psychadelic} {68 Rave} {69 Showtunes} {70 Trailer} {71 Lo-Fi} {72 Tribal} {73 {Acid Punk}} {74 {Acid Jazz}} {75 Polka} {76 Retro} {77 Musical} {78 {Rock & Roll}} {79 {Hard Rock}} {80 Folk} {81 Folk-Rock} {82 {National Folk}} {83 Swing} {84 {Fast Fusion}} {85 Bebob} {86 Latin} {87 Revival} {88 Celtic} {89 Bluegrass} {90 Avantgarde} {91 {Gothic Rock}} {92 {Progressive Rock}} {93 {Psychedelic Rock}} {94 {Symphonic Rock}} {95 {Slow Rock}} {96 {Big Band}} {97 Chorus} {98 {Easy Listening}} {99 Acoustic} {100 Humour} {101 Speech} {102 Chanson} {103 Opera} {104 {Chamber Music}} {105 Sonata} {106 Symphony} {107 {Booty Bass}} {108 Primus} {109 {Porn Groove}} {110 Satire} {111 {Slow Jam}} {112 Club} {113 Tango} {114 Samba} {115 Folklore} {116 Ballad} {117 {Power Ballad}} {118 {Rhythmic Soul}} {119 Freestyle} {120 Duet} {121 {Punk Rock}} {122 {Drum Solo}} {123 {A capella}} {124 Euro-House} {125 {Dance Hall}}}
  array set v2ContentTypes $v2ContentTypesList

  proc parseFile {filename} {
    variable tokens
    variable textFieldNames
    set token [getNewToken]
    if {[file readable $filename]} {
      set fd [open $filename "r"]
      fconfigure $fd -translation binary

      #verify this file has ID3 id
      set id [read $fd 3]
      if {![string equal $id "ID3"]} {
        #check if it's an ID3v1 tag
        seek $fd -128 end
        set tag [read $fd 3]
        if {[string equal $tag "TAG"]} {
          array unset infoArray
          set infoArray(title)  [string trim [read $fd 30] " \x00"]
          set infoArray(artist) [string trim [read $fd 30] " \x00"]
          set infoArray(album)  [string trim [read $fd 30] " \x00"]
          set infoArray(year)   [string trim [read $fd 4]  " \x00"]
          set comment           [read $fd 30]
          if {[string equal [string index $comment 28] "\x00"]} {
            set track [bytesToInt [string index $comment 29]]
            set comment [string range $comment 0 27]
          } else {
            set track ""
          }
          set infoArray(comment) [string trim $comment " \x00"]
          set infoArray(track) $track
          set infoArray(contentType) [bytesToInt [read $fd 1]]

          set tokens($token,info) [array get infoArray]
          set tokens($token,status) "Done"
        } else {
          set tokens($token,status) "No ID3 id found"
        }
      } else {
        set majorVersion [bytesToInt [read $fd 1]]
        set minorVersion [bytesToInt [read $fd 1]]
        if {$majorVersion != 4 && $majorVersion != 3 && $majorVersion != 2} {
          set tokens($token,status) "Only ID3v1, ID3v1.1, ID3v2.2 and ID3v2.3 and ID3v2.4 are currently supported"
          close $fd
          return $token
        }
        set flags [read $fd 1]
        binary scan $flags B* ls
        foreach {unsynch extendedHeader experimental footer junk1 junk2 junk3 junk4} [split $ls {}] {break}
        if {[expr {$junk1 | $junk2 | $junk3 | $junk4}] != 0} {
          set tokens($token,status) "undefined flags set in header"
        } else {
          set size [syncsafeToInt [read $fd 4]]
          set remainingTagSize $size
          if {$extendedHeader} {
            set tokens($token,status) "Extended header present but unimplemented"
          } elseif {$footer} {
            set tokens($token,status) "Footer present but unimplemented"
          } else {
            set frameList {}
            set error 0
            array unset infoArray
            set msg ""
            while {$remainingTagSize > 0} {
              switch -exact -- $majorVersion {
                2 {
                  set frameID [read $fd 3]
                  set frameSize [bytesToInt [read $fd 3]]
                }
                3 {
                  set frameID [read $fd 4]
                  set frameSize [bytesToInt [read $fd 4]]
                  set frameFlags [read $fd 2]
                }
                4 {
                  set frameID [read $fd 4]
                  set frameSize [syncsafeToInt [read $fd 4]]
                  set frameFlags [read $fd 2]
                }
                default {
                  append msg " unhandled majorVersion $majorVersion"
                }
              }

              set frameData [read $fd $frameSize]
              if {[string equal [string index $frameID 0] \x00]} {
                #padding has started
                break
              }
              if {![string is alnum $frameID]} {
                set tokens($token,status) "Non-alpha frame ID found [binToHex $frameID] \"$frameID\""
                set error 1
                break
              }
              switch -glob -- $frameID {
                AENC { }
                APIC { }
                COMM { }
                COMR { }
                ENCR { }
                EQUA { }
                ETCO { }
                GEOB { }
                GRID { }
                IPLS { }
                LINK { }
                MCDI { }
                MLLT { }
                OWNE { }
                PRIV { }
                PCNT { }
                POPM { }
                POSS { }
                RBUF { }
                RVAD { }
                RVRB { }
                SEEK {
                  append msg " SEEK found, appended tags not yet implemented"
                }
                SYLT { }
                SYTC { }
                TXXX { }
                T??? {
                  if {[info exists textFieldNames($frameID)]} {
                    set fieldName $textFieldNames($frameID)
                    set infoArray($fieldName) [encodedStringToString $frameData]
                  } else {
                    append msg " {unhandled frame type T* $frameID}"
                  }
                }
                UFID { }
                USER { }
                USLT { }
                WCOM { }
                WCOP { }
                WOAF { }
                WOAR { }
                WOAS { }
                WORS { }
                WPAY { }
                WPUB { }
                WXXX { }
                BUF { }
                CNT { }
                COM { }
                CRA { }
                CRM { }
                ETC { }
                EQU { }
                GEO { }
                IPL { }
                LNK { }
                MCI { }
                MLL { }
                PIC { }
                POP { }
                REV { }
                RVA { }
                SLT { }
                STC { }
                TXX { }
                T?? {
                  if {[info exists textFieldNames($frameID)]} {
                    set fieldName $textFieldNames($frameID)
                    set infoArray($fieldName) [encodedStringToString $frameData]
                  } else {
                    append msg " {unhandled frame type T* $frameID}"
                  }
                }
                UFI { }
                ULT { }
                WAF { }
                WAR { }
                WAS { }
                WCM { }
                WCP { }
                WPB { }
                WXX { }
                default {
                  append msg " {unhandled frame type $frameID}"
                }
              }
              lappend frameList "$frameID $frameSize"

              incr remainingTagSize -10
              incr remainingTagSize -$frameSize
              #append msg "$remainingTagSize left adding $frameID $frameSize [binToHex $frameFlags]"
            }
            if {[info exists infoArray]} {
              set tokens($token,info) [array get infoArray]
            }
            if {!$error} {
              set tokens($token,status) "Done$msg"
            }
          }
        }
      }
      close $fd
    } else {
      set tokens($token,status) "File unreadable"
    }
    return $token
  }

  proc getNewToken {} {
    variable nextTokenNumber
    variable tokens
    set tokenName "id3v2reader_$nextTokenNumber"
    incr nextTokenNumber
    set tokens($tokenName,valid) 1
    return $tokenName
  }

  proc cleanup {token} {
    if {[info exists tokens($token,valid)]} {
      array reset tokens "${token},*"
    }
  }

  proc getStatus {token} {
    variable tokens
    if {[info exists tokens($token,valid)]} {
      return $tokens($token,status)
    } else {
      return "The token \"$token\" is invalid"
    }
  }

  proc getInfo {token} {
    variable tokens
    if {[info exists tokens($token,valid)]} {
      if {[info exists tokens($token,info)]} {
        return $tokens($token,info)
      } else {
        return ""
      }
    } else {
      return ""
    }
  }

  proc bestFilename {token} {
    variable tokens
    if {[info exists tokens($token,valid)]} {
      #the best name is this format:
      #{artist} {title}
      if {[info exists tokens($token,info)]} {
        array set infoA $tokens($token,info)
        #if {[info exists infoA(track)]} {
        #  set trackNum [lindex [split $infoA(track) /] 0]
        #  if {[string is digit -strict $trackNum]} {
        #    set thisTrack "[format "%02d" [string trim $trackNum] ]-"
        #  } else {
        #    set thisTrack ""
        #  }
        #} else {
        #  set thisTrack ""
        #}
        set artist ""
        foreach type {artist band composer} {
          if {[info exists infoA($type)]} {
            set artist "$infoA($type)-"
            break
          }
        }
        set title ""
        foreach type {title subtitle} {
          if {[info exists infoA($type)]} {
            set title "$infoA($type)-"
            break
          }
        }
        #set rawName [string trim "$thisTrack$artist$title" " -"]
        set rawName [string trim "$artist$title" " -"]
        set bestName [string map {* % | % \\ % / % : % \" % < % > % ? %} $rawName]
        #"
        return $bestName
      } else {
        return ""
      }
    } else {
      return ""
    }
  }

  proc encodedStringToString {d} {
    set encoding [bytesToInt [string range $d 0 0]]
    set data [string range $d 1 end]
    #puts [binToHex $data]
    switch -exact -- $encoding {
      0 {
        #nothing
      }
      1 {
        set data [encoding convertfrom unicode $data]
        set data [string range $data 1 end]
      }
      2 {
        #not sure about this one, should there be a \xfe\xff or \xff\xfe prepended to the data?
        set data [encoding convertfrom unicode $data]
      }
      3 {
        set data [encoding convertfrom utf-8 $data]
      }
      default {
        #is there a better way to return and handle this case?
        return "unhandled text encoding $encoding"
      }
    }
    return [lindex [split $data "\x00"] 0]
  }

  proc bytesToInt {s} {
    #set paddingBytes [expr "8 - ([string length $s] % 8)"]
    #if {$paddingBytes != 0 && $paddingBytes < 8} {
    #  set s [string repeat \x00 $paddingBytes]$s
    #}
    binary scan $s c* l
    set sum 0
    foreach i $l {
      set i [expr {$i & 0xff}]
      set sum [expr {($sum << 8) + $i}]
    }
    return $sum
  }

  proc syncsafeToInt {s} {
    binary scan $s c* l
    set sum 0
    foreach i $l {
      set i [expr {$i & 0xff}]
      set sum [expr {($sum << 7) + $i}]
    }
    return $sum
  }

  proc binToHex {s} {
    binary scan $s H* hex
    return $hex
  }
}

proc bestRename {filename rename} {
  set t [id3v2reader::parseFile $filename]
  set bestName "[id3v2reader::bestFilename $t].mp3"
  puts $bestName
  if {$rename} {
    file rename $filename $bestName
  }
  id3v2reader::cleanup $t
}

proc getInfo {filename} {
  set t [id3v2reader::parseFile $filename]
  puts "[id3v2reader::getInfo $t]"
  id3v2reader::cleanup $t
}
